home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / dos.swg / 0089_Real Mode BIOS example.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-02-28  |  4.3 KB  |  184 lines
  1. program BIOS;
  2. { Compile in real mode only }
  3. uses
  4.   Dos, Crt;
  5.  
  6. const
  7.   Coms:array[0..3] of String= ('Com1: ', 'Com2: ', 'Com3: ', 'Com4: ');
  8.   Lpts:array[0..2] of String= ('Lpt1: ', 'Lpt2: ', 'Lpt3: ');
  9.  
  10. type
  11.   PBios = ^TBios;
  12.   TBios = Record
  13.     SerialPortAdd    : Array [0..3] of Word;
  14.     ParallelPortAdd  : Array [0..3] of Word;
  15.     EqptFlags        : Word;
  16.     MfgrTestFlags    : Byte;
  17.     MainMem,
  18.     ExpRam,
  19.     KbdStat          : Word;
  20.     KeyPad           : Byte;
  21.     KbdBuffHead,
  22.     KbdBuffTail      : Word;
  23.     KbdBuff          : Array [0..31] of Char;
  24.     SeekStatus,
  25.     MortotStatus,
  26.     MortoCnt,
  27.     DiskError        : Byte;
  28.     NECStatus        : Array [0..6] of Byte;
  29.     VideoMode        : Byte;
  30.     ScrnWidth,
  31.     VideoBufferSize,
  32.     VideoBufferOfs   : Word;
  33.     CursorPos        : Array [0..7,0..1] of Byte;
  34.     CursorBottom,
  35.     CursorTop,
  36.     ActiveDisplayPage : Byte;
  37.     ActiveDisplayPort : Word;
  38.     CRTModeReg,
  39.     Palette           : Byte;
  40.     DataEdgeTimeCount,
  41.     CRCReg            : Word;
  42.     LastCharInput     : Char;
  43.     Tick              : Word;
  44.     Hour              : Integer;
  45.     TimerOverFlow,
  46.     BrkStatus         : Byte;
  47.     ResetFlag         : Word;
  48.     HardDiskStatus    : LongInt;
  49.     ParallelTimeout,
  50.     SerialTimeout     : Array[0..3] of Byte;
  51.     KbdBufferOfs,
  52.     KbdBufferEnd      : Word;
  53.   End;
  54.   AtBios = Record
  55.     Name : Array[0..164] of Char;
  56.   End;
  57.  
  58. var
  59.   SaveAttr: Byte;
  60.  
  61. procedure FlushKeyBuffer;
  62. var
  63.   Recpack : registers;
  64. begin
  65.   with recpack do begin
  66.     Ax := ($0c shl 8) or 6;
  67.     Dx := $00ff;
  68.   end;
  69.   Intr($21,recpack);
  70. end;
  71.  
  72. Procedure CursorOff; assembler;
  73. asm
  74.   mov AH, $01;
  75.   mov CH, $20;
  76.   mov CL, $20;
  77.   int $10;
  78. End;
  79.  
  80. procedure CursorSmall;
  81. Begin
  82.   if LastMode <> CO80 then asm
  83.     mov AH, $01;
  84.     mov CH, 12;
  85.     mov CL, 13;
  86.     int $10;
  87.   end else asm;
  88.     mov AH, $01;
  89.     mov CH, $06;
  90.     mov CL, $07;
  91.     int $10;
  92.   end;
  93. end;
  94.  
  95. function GetHexWord(w: Word): String;
  96. const
  97.  hexChars: array [0..$F] of Char =
  98.    '0123456789ABCDEF';
  99. begin
  100.  GetHexWord := hexChars[Hi(w) shr 4] + hexChars[Hi(w) and $F] +
  101.                hexChars[Lo(w) shr 4] + hexChars[Lo(w) and $F];
  102. end;
  103.  
  104. procedure WriteXY(X, Y: Integer; S: String);
  105. begin
  106.   GotoXY(X, Y);
  107.   Write(S);
  108. end;
  109.  
  110. procedure WriteXY2(X, Y: Integer; S: String; W: Word);
  111. begin
  112.   GotoXY(X, Y);
  113.   Write(S);
  114.   Write(W);
  115. end;
  116.  
  117. procedure WriteXY3(X, Y: Integer; S: String; B: Boolean);
  118. begin
  119.   GotoXY(X, Y);
  120.   Write(S);
  121.   Write(B);
  122.   ClrEOL;
  123. end;
  124.  
  125. procedure WriteData(Ticks: PBios);
  126. var
  127.   SaveAttr, i: Integer;
  128.  
  129. begin
  130.   for i := 0 to 3 do
  131.     WriteXY(1, 1 + i, Coms[i] + GetHexWord(Ticks^.SerialPortAdd[i]));
  132.   for i := 0 to 2 do
  133.     WriteXY(1, 6 + i, Lpts[i] + GetHexWord(Ticks^.ParallelPortAdd[i]));
  134.   WriteLn;
  135.   WriteXY2(1, 10, 'VideoMode: ', Ticks^.VideoMode);
  136.   WriteXY2(1, 11, 'Dos Mem: ', Ticks^.MainMem);
  137.   WriteXY(1, 12, 'Video Card Port Addresss: ' + GetHexWord(Ticks^.ActiveDisplayPort));
  138.   WriteXY2(1, 13, 'Tick: ', Ticks^.Tick);
  139.   WriteXY2(1, 14, 'Hour: ', Ticks^.Hour);
  140.   WriteXY2(1, 15, 'Break Status: ', Ticks^.BrkStatus);
  141.   WriteXY2(1, 16, 'Palette: ', Ticks^.Palette);
  142.   WriteXY3(1, 18, 'Right Shift: ', 0 <> Ticks^.KbdStat and 1);
  143.   WriteXY3(1, 19, 'Left Shift: ', 0 <> Ticks^.KbdStat and 2);
  144.   WriteXY3(1, 20, 'Ctrl : ', 0 <> Ticks^.KbdStat and 4);
  145.   WriteXY3(1, 21, 'Alt: ', 0 <> Ticks^.KbdStat and 8);
  146.   WriteXY3(1, 22, 'Scroll Lock: ', 0 <> Ticks^.KbdStat and 16);
  147.   WriteXY3(1, 23, 'Num Lock: ', 0 <> Ticks^.KbdStat and 32);
  148.   WriteXY3(1, 24, 'Caps Lock: ', 0 <> Ticks^.KbdStat and 64);
  149. {  WriteXY3(1, 24, 'Insert: ', 0 <> Ticks^.KbdStat and 128); }
  150.   GotoXY(1,25);
  151.   SaveAttr := TextAttr;
  152.   TextAttr := 0 + 7 * 16;
  153.   Write('  Press Shift, Alt, Caps Lock, etc, to see status of keys' +
  154.         '-- Any key to exit    ');
  155.   TextAttr := SaveAttr;
  156. end;
  157.  
  158. procedure Opening;
  159. begin
  160.   SaveAttr := TextAttr;
  161.   TextAttr := 7 + 1 * 16;
  162.   ClrScr;
  163.   GotoXY(1,25);
  164.   TextAttr := 0 + 7 * 16;
  165.   ClrEOL;
  166.   TextAttr := 11 + 1 * 16;
  167.   CursorOff;
  168. end;
  169.  
  170. var
  171.   Sel : Word;
  172.   Ticks: PBios;
  173. {  Ticks : TBios Absolute Seg0040; }
  174. begin
  175.   Opening;
  176.   Ticks := Ptr($0000, $0400);
  177.   repeat
  178.     WriteData(Ticks);
  179.   until KeyPressed;
  180.   CursorSmall;
  181.   FlushKeyBuffer;
  182.   TextAttr := SaveAttr;
  183. end.
  184.